home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / mkmsgsrc.zip / MSGEXPRT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-19  |  3KB  |  114 lines
  1. Program MsgExprt;
  2. {$IFDEF WINDOWS}
  3. {$M 16384, 8196}
  4. {$ELSE}
  5. {$M 16384, 0, 655360}
  6. {$ENDIF}
  7.  
  8. {$I MKB.Def}
  9.  
  10. {$X+}
  11.  
  12. {$IFDEF WINDOWS}
  13. Uses MKWCrt,
  14. {$ELSE}
  15. Uses
  16.   {$IFDEF OPRO}
  17.     OpCrt,
  18.   {$ELSE}
  19.     Crt,
  20.   {$ENDIF}
  21. {$ENDIF}
  22. MKMsgAbs, MKMsgSqu, MKMsgFid, MKMsgHud, MKDos, MKstring;
  23.  
  24. Var
  25.   MsgOut: AbsMsgPtr;
  26.   TmpStr: String;
  27.   AreaId: String;
  28.   OutFile: Text;
  29.   OutName: String;
  30.  
  31. Const
  32.   StLen = 78;
  33.  
  34. Begin
  35. If ParamCount < 2 Then
  36.   Begin
  37.   WriteLn('Proper syntax is:');
  38.   WriteLn('MsgExprt OutPut.Txt MsgAreaId');
  39.   WriteLn;
  40.   WriteLn('   Squish MsgAreaId Example = SC:\Max\Msg\Muffin');
  41.   WriteLn('   Hudson MsgAreaId Example = H042C:\MK\MsgBase');
  42.   WriteLn('   *.Msg  MsgAreaId Example = FC:\Mail');
  43.   WriteLn;
  44.   Halt(1);
  45.   End;
  46. AreaId := Upper(ParamStr(2));
  47. OutName := Upper(ParamStr(1));
  48. WriteLn('Exporting to ', OutName);
  49. Assign(OutFile, OutName);
  50. ReWrite(OutFile);
  51. If IoResult <> 0 Then
  52.   Begin
  53.   WriteLn('Unable to create output file');
  54.   Halt(3);
  55.   End;
  56. Case AreaId[1] of
  57.   'H': MsgOut := New(HudsonMsgPtr, Init);
  58.   'S': MsgOut := New(SqMsgPtr, Init);
  59.   'F': MsgOut := New(FidoMsgPtr, Init);
  60.   Else
  61.     Begin
  62.     WriteLn('Invalid message base type');
  63.     Halt(1);
  64.     End;
  65.   End;
  66. MsgOut^.SetMsgPath(Copy(AreaId,2,128));
  67. If MsgOut^.OpenMsgBase <> 0 Then
  68.   Begin
  69.   WriteLn('Error opening message base');
  70.   Halt(2);
  71.   End;
  72. WriteLn;
  73. WriteLn;
  74. MsgOut^.SeekFirst(1);
  75. While MsgOut^.SeekFound Do
  76.   Begin
  77.   WriteLn(OutFile, '--------------------------------------------------------------------------');
  78.   MsgOut^.MsgStartUp;
  79.   Write(OutFile, 'Message Number: ' + Long2Str(MsgOut^.GetMsgNum));
  80.   Write(#13);
  81.   Write(MsgOut^.GetMsgNum);
  82.   If MsgOut^.IsPriv Then
  83.     Write(OutFile,'  (Priv)');
  84.   If MsgOut^.IsRcvd Then
  85.     Write(OutFile, ' (Rcvd)');
  86.   WriteLn(OutFile);
  87.   Write(OutFile, 'From: ' + PadRight(MsgOut^.GetFrom,' ',45));
  88.   Write(OutFile, 'Date: ');
  89.   WriteLn(OutFile, ReformatDate(MsgOut^.GetDate, 'MM/DD/YY')
  90.     + ' ' + MsgOut^.GetTime);
  91.   WriteLn(OutFile, 'To: ' + MsgOut^.GetTo);
  92.   Write(OutFile, 'Subj: ');
  93.   WriteLn(OutFile,MsgOut^.GetSubj);
  94.   WriteLn(OutFile);
  95.   MsgOut^.MsgTxtStartUp;
  96.   TmpStr := MsgOut^.GetString(StLen);
  97.   While (Not MsgOut^.EOM) Do
  98.     Begin
  99.     WriteLn(OutFile, TmpStr);
  100.     TmpStr := MsgOut^.GetString(StLen);
  101.     End;
  102.   If IoResult <> 0 Then;
  103.   MsgOut^.SeekNext;
  104.   End;
  105. Close(OutFile);
  106. If IoResult <> 0 Then
  107.   Begin
  108.   WriteLn('Error in output file');
  109.   Halt(3);
  110.   End;
  111. If MsgOut^.CloseMsgBase <> 0 Then;
  112. Dispose(MsgOut, Done);
  113. End.
  114.